home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr09 / enft2ged.zip / ENFT2GED.BAS < prev    next >
BASIC Source File  |  1993-06-01  |  10KB  |  312 lines
  1. 1000 if COMMAND$="2" then _
  2.        line input"press <Enter> to continue";a$
  3. 1001 cls
  4. 1002 print"program=EnFT2Ged  version=3-Jun-1992"
  5. 1003 print"author=Brian Harney, Frankfort, KY":_
  6.      print">>>> this program is in the public domain <<<<":_
  7.      print
  8. 1004 print"Reads individual-list report-file from the program":_
  9.      print"'Enhanced Family Tree' and writes a GEDCOM file."
  10. 1005 print"Limit of 5000 individuals."
  11. 1006 print
  12. 1010 V$="###,###"
  13. 1011 DIM F$(5000)
  14. 1012 if COMMAND$="2" then 20000
  15. 1014 if COMMAND$="3" then 30000
  16.  
  17. 1050 ZC=csrlin: _
  18.      line input"input file ";FI$
  19. 1051 if FI$="" then FI$="ENFT0"
  20. 1070 open"I",1,FI$: _
  21.      locate ZC: _
  22.      print FI$;" opened for input."
  23. 1072 FO$="ENFT1"
  24. 1074 open"O",2,FO$: _
  25.      print FO$;" opened for output."
  26. 1075 print"Pass 1 of 4..."
  27.  
  28. 1100 '*****
  29. 1102 if eof(1) then close: print"eof": _
  30.        locate 23,1: line input"press <Enter> to continue";a$:_
  31.        cls:_
  32.        end
  33. 1103 line input #1,a$: a=a+1: if int(a/5)*5=a then locate 12,1: print a
  34. 1108 if a$="" then 1102
  35. 1109 if a$=string$(len(a$),32) then 1102
  36. 1110 if a$=chr$(12) then 1102
  37. 1111 zq=4
  38. 1112 if left$(a$,13)<>"       Name: " then 1120
  39. 1113   Gosub 2000
  40. 1114   Z$=mid$(A$,14,39): Gosub 2020: if zl<2 then beep: close: end
  41. 1115   NA$=mid$(a$,14,zl-1): NID$=mid$(a$,14+zl,z2)
  42. 1116   if len(a$)>65 then MF$=mid$(a$,66,1) else MF$="M"
  43. 1118   goto 1100
  44. 1120 if left$(a$,13)="-------------" then _
  45.        if NA$<>"" then _
  46.          Gosub 1300:_
  47.          goto 1100
  48. 1130 '---
  49. 1132 if left$(a$,12)<>"Birth place:" then 1140
  50. 1133   if len(a$)<14 then 1140
  51. 1135   BP$=mid$(a$,14,39)
  52. 1136   if len(a$)>65 then BD$=mid$(a$,66,len(a$)-65):_
  53.          Z$=BD$: gosub 7000: BD$=Z$
  54. 1137   if len(BD$)<11 then BD$=" "+BD$: goto 1137
  55. 1138   goto 1100
  56. 1140 '---
  57. 1142 if left$(a$,12)<>"Death place:" then 1160
  58. 1143   if len(a$)<14 then 1160
  59. 1145   DP$=mid$(a$,14,39)
  60. 1146   if len(a$)>65 then DD$=mid$(a$,66,len(a$)-65):_
  61.          Z$=DD$: gosub 7000: DD$=Z$
  62. 1147   if len(DD$)<11 then DD$=" "+DD$: goto 1147
  63. 1148   goto 1100
  64. 1160 '---
  65. 1162 if left$(a$,12)<>"    Mother: " then 1170
  66. 1163   if len(a$)<14 then 1170
  67. 1164   Z$=mid$(A$,13,39): Gosub 2020: _
  68.        if zl<2 then beep: print"#1164": close: end
  69. 1165   MO$=mid$(a$,12,zl): MOID$=mid$(a$,13+zl,z2)
  70. 1168   goto 1100
  71. 1170 '---
  72. 1172 if left$(a$,12)<>"    Father: " then 1180
  73. 1173   if len(a$)<14 then 1180
  74. 1174   Z$=mid$(A$,13,39): Gosub 2020: _
  75.        if zl<2 then beep: print"#1174": close: end
  76. 1175   FA$=mid$(a$,12,zl): FID$=mid$(a$,13+zl,z2)
  77. 1178   goto 1100
  78. 1180 '---
  79. 1182 if left$(a$,3)<>"M. " then 1199
  80. 1183   if len(a$)<9 then 1199
  81. 1184   Z$=mid$(A$,5,39): Gosub 2020: _
  82.        if zl<2 then beep: print"#1184": close: end
  83. 1185   SPID$=mid$(a$,4+zl,z2)
  84. 1188   goto 1100
  85. 1199 goto 1100
  86.  
  87. 1300 '****
  88. 1302 Z$=NID$ : gosub 3100: NID$=Z$:_
  89.      Z$=FID$ : gosub 3100: FID$=Z$:_
  90.      Z$=MOID$: gosub 3100: MOID$=Z$:_
  91.      Z$=SPID$: gosub 3100: SPID$=Z$
  92. 1303 Z$=NA$  : gosub 3000: gosub 4000: NA$=Z$ :_
  93.      print #2,NID$;FID$;MOID$;SPID$;" ";NA$;MF$;" ";BD$;" ";BP$;DD$;" ";DP$;"."
  94. 1308 Z$=FA$  : gosub 3000: gosub 4000: FA$=Z$ :_
  95.      print #2,FID$;"             ";FA$;string$((160-17)-len(FA$)," ");"."
  96. 1323 Z$=MO$  : gosub 3000: gosub 4000: MO$=Z$ :_
  97.      print #2,MOID$;"             ";MO$;string$((160-17)-len(MO$)," ");"."
  98. 1385 gosub 2000
  99. 1390 print #2,"---"
  100. 1399 return
  101.  
  102. 2000 '*****
  103. 2010 NA$="":NID$=""
  104. 2012 FA$="":FID$=""
  105. 2014 MO$="":MOID$=""
  106. 2015 BP$="":BD$="          "
  107. 2017 DP$="":DD$="          "
  108. 2019 return
  109.  
  110. 2020 zl=58: if len(Z$)<57 then zl=len(Z$)+1: locate 20: print zl: print Z$
  111. 2021 zl=zl-1: if zl<2 then return
  112. 2022  if mid$(Z$,zl,1)=" " then 2021
  113. 2024  if mid$(Z$,zl,1)=")" then z2=zl: gosub 2100
  114. 2026  if mid$(Z$,zl,1)<>" " then return
  115. 2099 return
  116.  
  117. 2100 '****
  118. 2101 zl=zl-1: if zl<2 then beep: print"zl<2 at 2101":print a$: close: end
  119. 2105  if mid$(z$,zl,1)="(" then z2=z2-zl: return
  120. 2106 goto 2101
  121.  
  122. 3000 '****
  123. 3002 if Z$="" or Z$=" " then return
  124. 3010 if left$(Z$,1)=" " then Z$=right$(Z$,len(Z$)-1): goto 3010
  125. 3012 if right$(Z$,1)=" " then Z$=left$(Z$,len(Z$)-1): goto 3012
  126. 3020 return
  127.  
  128. 3100 '****
  129. 3112 if right$(Z$,1)=")" then Z$=left$(Z$,len(Z$)-1)
  130. 3114 if left$(Z$,1)="(" then Z$=right$(Z$,len(Z$)-1)
  131. 3115 if left$(Z$,1)="#" then Z$=right$(Z$,len(Z$)-1)
  132. 3116 if right$(Z$,1)=" " then Z$=left$(Z$,len(Z$)-1): goto 3116
  133. 3118 if len(Z$)>4 then Z$=">"+left$(Z$,3)
  134. 3119 if len(Z$)<4 then Z$=" "+Z$: goto 3119
  135. 3120 return
  136.  
  137. 4000 '**** put slashes around surname
  138. 4010 z=len(Z$)+1: if len(Z$)<3 then return
  139. 4020 if instr(Z$," ")=0 then return
  140. 4030 z=z-1: if z<2 then return
  141. 4032  if mid$(Z$,z,1)<>" " then 4030
  142. 4034  GIVN$=left$(Z$,z)
  143. 4035  SURN$=right$(Z$,len(Z$)-z)
  144. 4038  Z$=GIVN$+"/"+SURN$+"/"
  145. 4039  if len(Z$)<39 then Z$=Z$+" ": goto 4039
  146. 4040 return
  147.  
  148. 5000 '****
  149. 5010 if I$(val(FID$))="1" then z=1 else z=0
  150. 5020 if z=0 then I$(val(FID$))="1"
  151. 5030 return
  152.  
  153. 7000 '**** fix a date to European format
  154. 7002 DA$="  ": MM$="zzz": YYYY$="    ": locate 15,1: print Z$;"  "
  155. 7010 if len(Z$)>5 then if right$(Z$,4)="????" then _
  156.        Z$=left$(Z$,len(Z$)-4)
  157. 7011 if len(Z$)>5 then if mid$(Z$,len(Z$)-4,1)="/" then _
  158.        YYYY$=right$(Z$,4):_
  159.        Z$=left$(Z$,len(Z$)-4)
  160. 7014 if right$(Z$,1)="/" then Z$=left$(Z$,len(Z$)-1)
  161. 7015 z=instr(Z$,"/"): _
  162.      if z=2 or z=3 then _
  163.        MM$=left$(Z$,z-1):_
  164.        if len(Z$) > z then Z$=right$(Z$,len(Z$)-z)
  165. 7017 z=instr(Z$,"/"): _
  166.      if z=2 or z=3 then _
  167.        DA$=left$(Z$,z-1)
  168. 7018 if len(Z$)=1 or len(Z$)=2 then _
  169.       if val(Z$)>0 then DA$=Z$
  170. 7019 'rint Z$;"  "DA$;"  ": delay 3
  171. 7020 if MM$="?" or MM$="??" or val(MM$)=0 then MM$="   "
  172. 7021 if val(MM$)=1  then MM$="Jan"
  173. 7022 if val(MM$)=2  then MM$="Feb"
  174. 7023 if val(MM$)=3  then MM$="Mar"
  175. 7024 if val(MM$)=4  then MM$="Apr"
  176. 7025 if val(MM$)=5  then MM$="May"
  177. 7026 if val(MM$)=6  then MM$="Jun"
  178. 7027 if val(MM$)=7  then MM$="Jul"
  179. 7028 if val(MM$)=8  then MM$="Aug"
  180. 7029 if val(MM$)=9  then MM$="Sep"
  181. 7030 if val(MM$)=10 then MM$="Oct"
  182. 7031 if val(MM$)=11 then MM$="Nov"
  183. 7032 if val(MM$)=12 then MM$="Dec"
  184. 7040 if len(DA$)<2 then DA$="0"+DA$
  185. 7042 if len(YYYY$)<4 then YYYY$="0"+YYYY$: goto 7042
  186. 7043 if YYYY$="    " then MM$="   "
  187. 7044 if MM$="   " then DA$="  "
  188. 7045 Z$=DA$+" "+MM$+" "+YYYY$
  189. 7047 if len(Z$)<11 then Z$=" "+Z$: goto 7047
  190. 7048 locate 16,1: print Z$;"  "
  191. 7049 return
  192.  
  193. 20000 '*****
  194. 20002 print"Pass 3 of 4..."
  195. 20010 open"I",1,"ENFT2":_
  196.       print "ENFT2 opened for input."
  197. 20015 open"O",2,"ENFT3":_
  198.       print "ENFT3 opened for output."
  199. 20016 line input #1,ap$: a=a+1: locate 15: print a
  200. 20017  if len(ap$)<4 then if eof(1) then 20100 else 20016
  201. 20018  if ap$="" or ap$=string$(len(ap$)," ") then if eof(1) then 20100 else 20016
  202. 20019  if ap$=string$(len(ap$)-1," ")+"." then if eof(1) then 20100 else 20016
  203. 20020 if eof(1) then 20100
  204. 20025  line input #1,a$: a=a+1: locate 15: print a
  205. 20027  if len(a$)<4 then if eof(1) then 20100 else 20025
  206. 20028  if a$="" or a$=string$(len(a$)," ") then if eof(1) then 20100 else 20025
  207. 20029  if a$=string$(len(a$)-1," ")+"." then if eof(1) then 20100 else 20016
  208. 20030  if left$(a$,4) <> left$(ap$,4) then print #2,ap$: b=b+1
  209. 20035  ap$=a$
  210. 20040  goto 20020
  211. 20100 '---
  212. 20102 if left$(a$,4) <> left$(ap$,4) then print #2,ap$: b=b+1
  213. 20104 close:_
  214.       locate 15: _
  215.       print "in>";a: _
  216.       print "out>";b: _
  217.       end
  218.  
  219. 30000 '*****
  220. 30002 print"Pass 4 of 4..."
  221. 30010 open"I",1,"ENFT3":_
  222.       print "ENFT3 opened for input."
  223. 30015 open"O",2,"ENFT4.GED":_
  224.       print "ENFT4.GED opened for output."
  225. 30016 open"O",3,"ENFT4.FAM":_
  226.       print "ENFT4.FAM opened for output."
  227. 30017 gosub 30800
  228. 30020 if eof(1) then 30100
  229. 30022  line input #1,a$: a=a+1: locate 15: print a
  230. 30030  gosub 30600
  231. 30099  goto 30020
  232. 30100 '---
  233. 30104 locate 21
  234. 30105 print #3,"0 TRLR"
  235. 30198 close 3
  236. 32000 '---
  237. 32002 open"I",3,"ENFT4.FAM"
  238. 32004 if eof(3) then close: _
  239.          print"output is in ENFT4.GED":_
  240.          end
  241. 32006  line input #3,a$
  242. 32008  print #2,a$
  243. 32010  goto 32004
  244.  
  245. 30600 '**** reserved for future use
  246. 30602 NID$=mid$(a$,1,4)  : Z$=NID$: gosub 30700 : NID$=Z$
  247. 30603 print #2,"0 @I";NID$;"@ INDI"
  248. 30604 NA$=mid$(a$,18,39) : Z$=NA$ : gosub 30700 : NA$=Z$
  249. 30605 print #2,"1 NAME ";NA$
  250. 30610 SEX$=mid$(a$,57,1): _
  251.       print #2,"1 SEX ";SEX$
  252. 30620 BD$=mid$(a$,59,11) : Z$=BD$: gosub 30700: BD$=Z$
  253. 30622 BP$=mid$(a$,71,38) : Z$=BP$: gosub 30700: BP$=Z$
  254. 30624 DD$=mid$(a$,110,11): Z$=DD$: gosub 30700: DD$=Z$
  255. 30626 DP$=mid$(a$,122,37): Z$=DP$: gosub 30700: DP$=Z$
  256. 30630 if BD$=" " and BP$=" " then 30640
  257. 30631  print #2,"1 BIRT"
  258. 30632  print #2,"2 DATE ";BD$
  259. 30633  if BP$=" " then 30640
  260. 30634  print #2,"2 PLAC ";BP$
  261. 30640 if DD$=" " and DP$=" " then 30650
  262. 30641  print #2,"1 DEAT"
  263. 30642  print #2,"2 DATE ";DD$
  264. 30643  if DP$=" " then 30650
  265. 30644  print #2,"2 PLAC ";DP$
  266. 30650 FF$=mid$(a$,5,8): if FF$="        " then 30699
  267. 30652 gosub 30900: Z$=FF$: gosub 30700: FF$=Z$
  268. 30654 print #2,"1 FAMC @F";FF$;"@"
  269. 30660 '---
  270. 30662 print #3,"0 @F";FF$;"@ FAM"
  271. 30664 FA$=mid$(a$,5,4): if FA$="    " then 30665 else _
  272.       Z$=FA$: gosub 30700: FA$=Z$: _
  273.       print #3,"1 HUSB @I";FA$;"@"
  274. 30665 MO$=mid$(a$,9,4): if MO$="    " then 30699 else _
  275.       Z$=MO$: gosub 30700: MO$=Z$: _
  276.       print #3,"1 WIFE @I";MO$;"@"
  277. 30699 return
  278. 30700 '---
  279. 30701 if len(Z$)>1 then _
  280.         if right$(Z$,1)=" " then _
  281.           Z$=left$(Z$,len(Z$)-1): goto 30701
  282. 30702 if len(Z$)>1 then _
  283.         if left$(Z$,1)=" " then _
  284.           Z$=right$(Z$,len(Z$)-1): goto 30702
  285. 30703 return
  286.  
  287. 30800 '****
  288. 30802 PRINT#2,"0 HEAD":_
  289.       PRINT#2,"1 SOUR ENH-FAM-TREE":_
  290.       PRINT#2,"2 VERS 2.10":_
  291.       PRINT#2,"1 DEST Generic":_
  292.       PRINT#2,"1 DATE 02 JUN 1992":_
  293.       PRINT#2,"1 CHAR IBMPC":_
  294.       PRINT#2,"1 FILE xxx.GED"
  295. 30804 PRINT#2,"0 @S1@ SUBM":_
  296.       PRINT#2,"1 NAME Brian D. Harney":_
  297.       PRINT#2,"1 ADDR 111 Willowcrest Dr":_
  298.       PRINT#2,"2 CONT Frankfort, KY 40601":_
  299.       PRINT#2,"1 PHON (502) 875-4452"
  300. 30809 return
  301.  
  302. 30900 '*****
  303. 30902 z=0
  304. 30904 z=z+1: _
  305.       locate 17: print "curr-fam-number>";z: _
  306.       if z>zhi then 30920
  307. 30906 if F$(z)=FF$ then FF$=str$(z): return
  308. 30910 goto 30904
  309. 30920 zhi=zhi+1: _
  310.       locate 18: print "high-fam-number>";zhi
  311. 30922 F$(zhi)=FF$: FF$=str$(zhi)
  312. 30924 return